GetDiversionById Function

public function GetDiversionById(list, id) result(p)

given a list of diversion channels, returns a pointer to one diversion by id

Arguments

Type IntentOptional Attributes Name
type(Diversion), intent(in), POINTER :: list
integer(kind=short), intent(in) :: id

Return Value type(Diversion), POINTER


Variables

Type Visibility Attributes Name Initial
logical, public :: found

Source Code

FUNCTION GetDiversionById &
( list, id ) &
RESULT (p)

IMPLICIT NONE 

!Arguments with intent in:
TYPE (Diversion), POINTER, INTENT(IN) :: list !list of reservoirs
INTEGER (KIND = short), INTENT(IN)    :: id

!Arguments with intent out:
TYPE (Diversion), POINTER :: p !pointer to reservoir

!local arguments:
LOGICAL :: found

!------------end of declaration------------------------------------------------

!loop througout list of reservoirs searching for id
p => list
found = .false.
DO WHILE (ASSOCIATED(p)) 
  IF (p % id == id) THEN
    found = .TRUE.
    EXIT
  ELSE
    p => p % next
  END IF
ENDDO

IF (.NOT. found ) THEN
  CALL Catch ('error', 'Diversions', 'diversion not found by &
                       function GetDiversionById: ', argument = ToString(id))
END IF

RETURN
END FUNCTION GetDiversionById